home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d4 / gw_slt13.arc / SOURCE.ARC / SLTERM.PAS < prev    next >
Pascal/Delphi Source File  |  1990-04-01  |  8KB  |  285 lines
  1. PROGRAM SLTerm;  { for use with Joel Bergen's Global War Door }
  2.  
  3. USES
  4.   DOS, CRT, Async3, Mouse4, ANSI;
  5. TYPE
  6.   ScreenType = ARRAY [1..4000] OF BYTE;
  7. CONST
  8.   Version= '1.3';
  9.   Rev    = 'B';
  10.   Esc    = #27;
  11.   Ack    = #6;
  12.   AltI   = #23;
  13.   AltM   = #50;
  14.   AltX   = #45;
  15.   GWEnq  = #255;
  16.   Alpha  = ['A'..'Z','0'..'9','a'..'z','.',':','_'];
  17.   Special= ['!','"','#','$','&','%','0'..'9'];
  18. VAR
  19.   ScreenColor       : ScreenType ABSOLUTE $B800:0000;  {color}
  20.   ScreenVGA         : ScreenType ABSOLUTE $B800:4000;  {50 line}
  21.   ScreenMono        : ScreenType ABSOLUTE $B000:0000;  {mono}
  22.   buf               : ScreenType;
  23.   buffers           : array[1..9] of ScreenType;       {for screens}
  24.   Color,Local,Done  : BOOLEAN;
  25.   c,ch              : CHAR;
  26.   ComPort,
  27.   x,y,w,result      : WORD;
  28.   Regs              : REGISTERS;                       {DOS registers}
  29.   f                 : FILE;                            {for Maps}
  30.   f2                : TEXT;                            {for Capture}
  31.   i                 : INTEGER;
  32.   s                 : STRING;
  33.   Cap               : STRING[80];
  34.   Store,Lines       : BYTE;
  35.  
  36. PROCEDURE ExitProgram;
  37. BEGIN
  38.   Async_Close;
  39.   CLOSE(f);
  40.   IF Mouse_Installed THEN BEGIN
  41.     RestoreMouseXY;
  42.     HideMouse;
  43.   END;
  44.   WRITELN('Shadow Lord''s Enhanced Global War Term exited.');
  45.   HALT;
  46. END;
  47.  
  48.  
  49. FUNCTION ScreenChar(x,y:word) : CHAR;
  50. BEGIN
  51.   IF Color THEN
  52.     ScreenChar:=CHR(ScreenColor[((y-1)*80+x)*2-1])
  53.   ELSE
  54.     ScreenChar:=CHR(ScreenMono[((y-1)*80+x)*2-1]);
  55. END;
  56.  
  57. PROCEDURE Capture;
  58. BEGIN
  59.   ASSIGN(f2, 'SLTERM.IMG');
  60.   {$I-} APPEND(f2); {$I+}
  61.   IF IOResult<>0 THEN REWRITE(f2);
  62.   FOR Y:=1 TO 25 DO BEGIN
  63.     Cap:='';
  64.     FOR X:=1 TO 80 DO
  65.      Cap:=Cap+ScreenChar(X,Y);
  66.     WRITE(f2,Cap);
  67.   END;
  68.   CLOSE(f2);
  69. END;
  70.  
  71. FUNCTION MouseWord(x,y,len : WORD) : STRING;
  72. {mouse routine: gets a word pointed to by the mouse. For reading country
  73.  names, menu items, etc}
  74. VAR
  75.   s : STRING;
  76.   i : WORD;
  77. BEGIN
  78.   s:='';
  79.   IF ScreenChar(x,y) IN Alpha THEN BEGIN
  80.     WHILE (x>0) AND (ScreenChar(x,y) IN Alpha) DO
  81.       DEC(x);
  82.     IF (x>0) AND (ScreenChar(x,y)=' ') AND (ScreenChar(x-1,y) IN Alpha)
  83.     THEN BEGIN
  84.       DEC(x);
  85.       WHILE (x>0) AND (ScreenChar(x,y) IN Alpha) DO
  86.         DEC(x);
  87.     END;
  88.     INC(x);
  89.     FOR i:=1 TO len DO BEGIN
  90.       s:=s+ScreenChar(x,y);
  91.       INC(x);
  92.     END;
  93.   END;
  94.   MouseWord:=s;
  95. END;
  96.  
  97. PROCEDURE Menu;
  98. VAR
  99.   Choice: BYTE;
  100.   Chce  : STRING;
  101.   i,w   : Byte;
  102. BEGIN
  103.   IF Mouse_Installed THEN HideMouse;
  104.   i:=WhereY;
  105.   w:=WhereX;
  106.   IF Color THEN Move(ScreenColor, buf, 4000)
  107.    ELSE Move(ScreenMono, buf, 4000);
  108.   IF Mouse_Installed THEN ShowMouse;
  109.   Choice:=10;
  110.   GotoXY(1,23);
  111.   TextColor(7);
  112.   Writeln('  1:Globe  2:Africa  3:Asia  4:Australia  5:Europe  6:N.America  7:S.America ');
  113.   Writeln(' 8:Show_Player_Info  9:World_Report  0:Exit_Menu   Shadow Lord''s Enhanced GWT ');
  114.   WHILE Choice>9 DO BEGIN
  115.     IF Mouse_Installed THEN BEGIN
  116.       repeat until mouseposition(x,y)=0;
  117.       if MousePosition(x,y)>0 THEN BEGIN
  118.        Chce:=MouseWord(x,y,6);
  119.        IF LENGTH(Chce)>1 THEN
  120.         IF Chce[2]=':' THEN
  121.          if (Chce<='9') OR (Chce>='9') THEN VAL(Chce[1], Choice, result);
  122.        repeat until Mouseposition(x,y)=0;
  123.       END;
  124.     END;
  125.     IF KeyPressed THEN BEGIN;
  126.       Chce:=ReadKey;
  127.       if (Chce<='9') OR (Chce>='0') THEN VAL(Chce, Choice, result);
  128.     END;
  129.   END;
  130.   IF Mouse_Installed THEN HideMouse;
  131.   IF Color THEN Move(buf, ScreenColor, 4000)
  132.    ELSE Move(buf, ScreenMono, 4000);
  133.   IF (Choice>0) AND (Lines=50) THEN
  134.     Move(Buffers[choice], ScreenVGA, 4000)
  135.   ELSE IF (Choice>0) AND (Lines=25) THEN
  136.     Move(Buffers[choice], ScreenColor, 4000);
  137.   IF (Lines=25) and (ScreenChar(31,11)='N') then begin
  138.     repeat until keypressed;
  139.     if color then move(buf, ScreenColor, 4000)
  140.      else move(buf, ScreenMono, 4000);
  141.   end;
  142.   IF Mouse_Installed THEN ShowMouse;
  143.   GotoXY(w,i);
  144. END;
  145.  
  146. FUNCTION WaitForChar : CHAR;
  147. VAR t : WORD;
  148. BEGIN
  149.   t:=0;
  150.   REPEAT
  151.     INC(t);
  152.   UNTIL (t>65500) OR Async_Buffer_Check;
  153.   IF Async_Buffer_Check THEN
  154.     WaitForChar:=Async_Read
  155.   ELSE
  156.     WaitForChar:=#00;
  157. END;
  158.  
  159. BEGIN
  160.   ASSIGN(f,FEXPAND(FSEARCH('WAR.IMG',GETENV('PATH'))));
  161.   w:=IORESULT;
  162.   {$I-} RESET(f,1); {$I+}
  163.   IF IORESULT<>0 THEN BEGIN
  164.     WRITELN('WAR.IMG not found!');
  165.     HALT;
  166.   END;
  167.   IF FileSize(f)<32000 THEN BEGIN
  168.     WRITELN('You must use one of SLTerm''s Enhanced WAR.IMGs!'^G^G);
  169.     ExitProgram;
  170.   END;
  171.   VAL(PARAMSTR(1),ComPort,result);
  172.   VAL(PARAMSTR(2),Lines,result);
  173.   IF (ComPort<1) OR (ComPort>4) THEN
  174.    BEGIN
  175.     WRITELN('USAGE:  SLTERM ComPort(1-4) #Lines(25 or 50)');
  176.     CLOSE(f);
  177.     HALT;
  178.    END;
  179.   Regs.AH := $0F;
  180.   INTR($10,Regs);
  181.   IF Regs.AL=7 THEN
  182.     Color:=FALSE
  183.   ELSE
  184.     Color:=TRUE;
  185.   IF (Lines<>25) AND (Lines<>50) THEN Lines:=25; {Default to 25 Lines}
  186.   Async_CheckCTS := FALSE; {disable hardware handshaking}
  187.   Done:=NOT Async_Open(ComPort);
  188.   IF Lines=50 THEN TextMode(3+256);              {50 line mode}
  189.   IF NOT Done THEN WRITELN('SLTERM Version ',Version,' active.');
  190.   IF NOT Done THEN WRITELN('Alt-X to Exit, Alt-M for Menu, Alt-I to capture screen.');
  191.   X:=1;
  192.   WHILE X<10 DO BEGIN
  193.     SEEK(f,7*4000);                             {set up the buffer}
  194.     BlockRead(f,buffers[X],4000);
  195.     X:=X+1;
  196.   END;
  197.   IF Mouse_Installed THEN ShowMouse;
  198.   Store:=10;
  199.   WHILE NOT Done DO BEGIN
  200.     REPEAT
  201.       c:=#00;
  202.       IF Async_Buffer_Check THEN BEGIN
  203.         c:=Async_Read;
  204.         Local:=FALSE;
  205.       END ELSE IF KEYPRESSED THEN BEGIN
  206.         ch:=READKEY;
  207.         Local:=TRUE;
  208.         IF ch<>#0 THEN
  209.           Async_Send(ch)
  210.         ELSE BEGIN
  211.           ch:=ReadKey;
  212.           IF ch=AltX THEN ExitProgram; {alt-x quits program}
  213.           IF ch=AltM THEN Menu;        {alt-m calls up menu}
  214.           IF ch=AltI THEN Capture;     {alt-i captures screen}
  215.         END;
  216.       END
  217.       ELSE IF Mouse_Installed AND (MousePosition(x,y)>0) AND
  218.        (MousePosition(x,y)<3) THEN BEGIN
  219.         IF MousePosition(x,y)=2 THEN
  220.           Async_Send(#13)
  221.         ELSE BEGIN
  222.           IF ScreenChar(x,y) IN Special THEN S:=Screenchar(x,y)+':'
  223.           ELSE If ScreenChar(x,y) IN Alpha THEN S:=MouseWord(x,y,5);
  224.           c:=s[1];
  225.           IF s<>''THEN BEGIN
  226.             IF S[2]=':' THEN
  227.               Async_Send(c)
  228.             ELSE BEGIN
  229.               FOR i:=1 TO 5 DO
  230.                 Async_Send(s[i]);
  231.               Async_Send(#13);
  232.             END;
  233.           END;
  234.         END;
  235.         REPEAT UNTIL MousePosition(x,y)=0;
  236.         c:=#00;
  237.       END
  238.       ELSE IF Mouse_Installed AND (MousePosition(x,y)=4) THEN Menu;
  239.       IF NOT Async_Buffer_Check AND (Store<10) THEN BEGIN
  240.          IF Color THEN MOVE(ScreenColor, buffers[Store], 4000)
  241.          ELSE MOVE(ScreenMono, buffers[Store], 4000);
  242.       END;
  243.    UNTIL c<>#00;
  244.    IF Mouse_Installed THEN HideMouse;
  245.    IF (c=ESC) AND (NOT Local) THEN
  246.      BEGIN
  247.         c:=WaitForChar;
  248.         CASE c OF
  249.         GWEnq:BEGIN
  250.                 Async_Send(ACK);
  251.                 Async_Send(REV);
  252.                 c:=WaitForChar;
  253.                 IF c<>ACK THEN BEGIN
  254.                   WRITELN('THIS IS AN OBSELETE VERSION OF SLTERM!'^G^G);
  255.                   DELAY(5000);
  256.                 END;
  257.               END;
  258.           'M':BEGIN
  259.                 c:=WaitForChar;
  260.                 i:=ORD(c) - ORD('1');
  261.                 IF (i>=0) AND (i < (FILESIZE(f) DIV 4000)) THEN BEGIN
  262.                   SEEK(f,i*4000);
  263.                   Store:=i+1;
  264.                   BLOCKREAD(f,buf,4000);
  265.                   IF Color THEN
  266.                     MOVE(buf,ScreenColor,4000)
  267.                   ELSE
  268.                     MOVE(buf,ScreenMono,4000);
  269.                 END;
  270.               END;
  271.           'Q':Done := TRUE;
  272.           ELSE BEGIN
  273.             Display_ANSI(ESC);
  274.             Display_ANSI(c);
  275.           END;
  276.         IF ScreenChar(1,3)='~' THEN Store:=8         {player info}
  277.         ELSE IF ScreenChar(3,2)='A' THEN Store:=9;   {world report}
  278.       END;
  279.     END
  280.     ELSE Display_ANSI(c);
  281.     IF Mouse_Installed THEN ShowMouse;
  282.   END;
  283.   ExitProgram;
  284. END.
  285.